;;; spacing and drawing functions for a linear equation formatted diagram

(defpackage :linear-view
  (:use :cl :boxes.util)
  (:nicknames :lv)
  (:export :linear-view
           :old-trees))

(in-package :linear-view)

(defclass linear-view (d:diagram-view)
  ((old-trees :initform nil :accessor old-trees)
   (compressed-p :initform t :initarg :compressed :accessor compressed-p))
  (:default-initargs
   :arg-padding 0
    :arg-margin 0
    :box-margin 0))

(defun n-times-x-p (box)
  (and (= (length (tree:children box)) 3)
       (not (typep (second (tree:children box)) 'd:input-argument))
       (eq (d:quantity (second (tree:children box))) '*)
       (not (typep (first (tree:children box)) 'd:input-argument))
       (numberp (d:quantity (first (tree:children box))))
       (d:xbox-p (tree:child (third (tree:children box))))))

(defun precedence-level (op)
  (position-if (lambda (ops)
                 (find op ops))
               '((=) (* /) (+ -))))

(defun needs-parens-p (diagram box)
  (declare (ignore diagram))
  (let ((p (d:parent-box box)))
    (and (d:normal-box-p box)
         (d:normal-box-p p)
         (let ((pp (precedence-level (d:quantity (d:box-operator-arg p))))
               (bp (precedence-level (d:quantity (d:box-operator-arg box)))))
           (or (not pp) (not bp)
               (> bp pp)
               ;; - is not associative
               (and (eql bp pp)
                    (find box (tree:children (d:box-right-arg p)))
                    (eql (d:quantity (d:box-operator-arg p)) '-)))))))
    ;; (and (or (d:normal-box-p box)
    ;;          (every (lambda (b) (typep b 'd:input-argument)) (tree:children box)))
    ;;      (d:normal-box-p p)
    ;;      (not (and (compressed-p diagram)
    ;;                (n-times-x-p box))))))

(defun needs-equals (box)
  (and (= (length (tree:children box)) 1)
       (or (> (length (tree:children (tree:child box))) 1)
           (and (tree:children (tree:child box))
                (d:quantity (tree:child box))))))

(defmethod d:space-node ((root d:multi-argument-box) (diagram linear-view))
  (loop
     with needs-parens = (needs-parens-p diagram root)
     with lp-width = (text-width "(" (gwee:view-font diagram))
     with rp-width = (text-width ")" (gwee:view-font diagram))
     with eq-width = (text-width "=" (gwee:view-font diagram))
     with x = (+ (d:box-margin diagram) (if needs-parens lp-width 0))
     for arg in (tree:children root)
     for count from 0
     do
       (cond
         ((> (length (tree:children arg)) 1)
          (assert (= (length (tree:children arg)) 2))
          (let ((left (first (tree:children arg)))
                (right (second (tree:children arg))))
            (incf x (d:arg-padding diagram))
            (d:move-tree left x (geom:y arg))
            (incf x (+ (geom:width left) (d:arg-padding diagram)))
            ;; make space for the ='s
            (incf x (+ eq-width (d:arg-padding diagram)))
            (setf (geom:x arg) x)
            ;;(incf x (+ (geom:width arg) (d:arg-padding diagram)))
            (d:move-tree right x
                         (geom:y arg))
            (incf x (geom:width right))))
         ((and (tree:children arg)
               (d:quantity arg))
          (assert (= (length (tree:children arg)) 1))
          (incf x (d:arg-padding diagram))
          (d:move-tree (first (tree:children arg)) x (geom:y arg))
          (incf x (+ (geom:x (d:tree-dimensions (first (tree:children arg))))
                     (d:arg-padding diagram)))
          ;; make room for equal sign
          (incf x (+ eq-width (d:arg-padding diagram)))
          (setf (geom:x arg) x)
          (incf x (geom:width arg)))
         ((typep arg 'd:input-argument)
          (unless (zerop count)
            (incf x (d:arg-padding diagram)))
          (setf (geom:x arg) x)
          (incf x (geom:width arg)))
         (t
          (unless (zerop count)
            (incf x (d:arg-padding diagram)))
          (setf (geom:x arg) x)
          (let ((max 0))
            (dolist (i (tree:children arg))
              (d:move-tree i x (geom:y i))
              (when (> (geom:width i) max)
                (setf max (geom:width i))))
            (incf x (if (tree:children arg)
                        max
                        (geom:width arg))))))
     finally (setf (geom:width root) (+ x (d:box-margin diagram) (if needs-parens rp-width 0))
                   (geom:height root) (apply 'max (mapcar 'geom:height (tree:children root)))))
  (setf (geom:x root) 0
        (geom:y root) 0))

(defun drawing-quantity (arg)
  (cond
    ((typep arg 'd:input-argument)
     (d:quantity arg))
    ((d:xbox-p (tree:parent arg))
     "X")
    (t
     (d:quantity arg))))

(defun drawing-selected (arg)
  (declare (type d:argument arg))
  (or (d:selected arg)
      (and (tree:parent arg)
           (or
            (d:selected (tree:parent arg))
            (and (d:xbox-p (tree:parent arg))
                 (some 'drawing-selected (tree:parents (tree:parent arg))))))))

(defmethod d:space-node ((arg d:argument) (diagram linear-view))
  (let ((quantity (drawing-quantity arg)))
    (setf (geom:width arg) (cond
                             ((and (eq quantity '*)
                                   (compressed-p diagram)
                                   (n-times-x-p (tree:parent arg)))
                              0)
                             (quantity
                              (max (+ (text-width quantity (gwee:view-font diagram))
                                      (* 2 (d:arg-margin diagram)))
                                   (if (typep arg 'd:input-argument)
                                       (d:min-arg-width diagram)
                                       0)))
                             ((and (not (typep arg 'd:input-argument))
                                   (tree:children arg))
                              0)
                             (t
                              (d:min-arg-width diagram)))
          (geom:height arg) (+ (sdl:get-font-height :font (gwee:view-font diagram))
                               (* 2 (d:arg-margin diagram)))
          (geom:x arg) 0
          (geom:y arg) 0)
    (dolist (i (tree:children arg))
      (d:move-tree i 0 0 t))))

(defmethod d:space-node ((arg d:multi-input-argument) (diagram linear-view))
  (let ((quantity (drawing-quantity arg)))
    (setf (geom:width arg) (if quantity
                               (max (text-width quantity (gwee:view-font diagram))
                                    (* (d:input-argument-num-fields arg) (d:min-arg-width diagram)))
                               (* (d:input-argument-num-fields arg) (d:min-arg-width diagram)))
          (geom:height arg) (+ (sdl:get-font-height :font (gwee:view-font diagram))
                               (* 2 (d:arg-margin diagram)))
          (geom:x arg) 0
          (geom:y arg) 0)))

(defmethod d:space-node :after ((arg d:input-argument) (diagram linear-view))
  (dolist (i (tree:children arg))
    (d:move-tree i 0 0 t))
  (when (tree:children arg)
    (d:funcall-on-tree (lambda (n)
                         (setf (geom:width n) 0
                               (geom:height n) 0))
                       (ecase (length (tree:children arg))
                         (1 (first (tree:children arg)))
                         (2 (second (tree:children arg)))))))

(defun equals-position (box view &optional (x 0))
  (+ x (d:box-margin view)
     (geom:width (first (tree:children (tree:child box))))
     (d:arg-padding view)))

(defmethod d:draw-node ((node d:multi-argument-box) (view linear-view))
  (unless (and (zerop (geom:width node))
               (zerop (geom:height node)))
    (multiple-value-bind (x y) (gwee:translate-coordinates (geom:x node) (geom:y node) view)
      (if (d:selected node)
          (sdl:draw-box-* x y (geom:width node) (geom:height node) :color (gwee:color 255 214 214))
          (sdl:draw-box-* x y (geom:width node) (geom:height node) :color (gwee:gray 255)))
      (let ((centery (center-inside (geom:height node)
                                    (sdl:get-font-height :font (gwee:view-font view))
                                    y))
            (color (if (d:selected node)
                       (d:selected-color view)
                       (gwee:gray 0))
                       ;; (d:foreground (first (tree:children node)))
                       ))
        (when (needs-parens-p view node)
          (sdl:draw-string-blended-* "("
                                     (+ x (d:box-margin view))
                                     centery
                                     :color color
                                     :font (gwee:view-font view))
          (sdl:draw-string-blended-* ")"
                                     (- (+ x (geom:width node)) (d:box-margin view)
                                        (text-width ")" (gwee:view-font view)))
                                     centery
                                     :color color
                                     :font (gwee:view-font view)))
        (when (needs-equals node)
          (sdl:draw-string-blended-* "="
                                     (equals-position node view x)
                                     centery
                                     :color color
                                     :font (gwee:view-font view)))))))

(defmethod d:draw-node ((node d:argument) (view linear-view))
  (unless (zerop (geom:width node))
    (multiple-value-bind (x y) (gwee:translate-coordinates (geom:x node) (geom:y node) view)
      (sdl:draw-box-* x y (geom:width node) (geom:height node) :color (if (drawing-selected node)
                                                                          (gwee:color 255 214 214)
                                                                          (if (typep node 'd:input-argument)
                                                                              (d:background node)
                                                                              (gwee:gray 255))))
      (when (or (d:highlighted node)
                (d:highlighted (tree:parent node)))
        (sdl:draw-rectangle-* (1- x) (1- y) (+ (geom:width node) 2) (+ (geom:height node) 2) :color (if (d:selected node)
                                                                                                        (d:selected-color view)
                                                                                                        (d:highlight-color view))))
      ;;(sdl:draw-rectangle-* x y (geom:width node) (geom:height node) :color (d:outline node))
      (let ((quantity (drawing-quantity node)))
        (when quantity
          (sdl:draw-string-blended-* (if (stringp quantity)
                                         quantity
                                         (prin1-to-string quantity))
                                     (center-inside (geom:width node)
                                                    (text-width quantity (gwee:view-font view))
                                                    x)
                                     (center-inside (geom:height node)
                                                    (sdl:get-font-height :font (gwee:view-font view))
                                                    y)
                                     :color (if (drawing-selected node)
                                                (d:selected-color view)
                                                (d:foreground node))
                                     :font (gwee:view-font view)))))))


(defmethod d:space-tree ((diagram linear-view))
  (labels ((space (root)
             (d:funcall-on-tree (lambda (x) (setf (geom:x x) 0 (geom:y x) 0) (d:space-node x diagram))
                                root
                                :when :after)))
    (space (d:root diagram))
    (mapc #'space (old-trees diagram))))

(defmethod gwee:draw-view ((view linear-view))
  (when (d:root view)
    (d:funcall-on-tree (lambda (x) (d:draw-node x view)) (d:root view))
    (mapc (lambda (r)
            (d:funcall-on-tree (lambda (x) (d:draw-node x view)) r))
          (old-trees view)))
  (call-next-method))

(defun find-center-line (root diagram)
  (when (needs-equals root)
    (equals-position root diagram)))
                         
(defmethod d:update-diagram-view ((v linear-view))
  (when (d:root v)
    (d:space-tree v)
    (let ((center nil) ;;(find-center-line (d:root v) v))
          (vcenter (max (u:half (- (gwee:view-height v)
                                   (geom:height (d:root v))))
                        (reduce '+ (old-trees v) :key 'geom:height))))
      (if center
          (d:move-tree (d:root v)
                       (- (u:half (gwee:view-width v))
                          (- center (- (geom:x (d:root v)))))
                       vcenter
                       t)
          (d:move-tree (d:root v)
                       (u:half (- (gwee:view-width v) (if (old-trees v)
                                                          (geom:width (car (last (old-trees v))))
                                                          (geom:width (d:root v)))))
                       vcenter
                       t)))
    (loop for y = (geom:y (d:root v)) then (- y (geom:height o))
       for o in (old-trees v)
       for center = (find-center-line o v)
       do (d:move-tree o (if center
                             (- (u:half (gwee:view-width v))
                                (- center (- (geom:x o))))
                             (geom:x (d:root v)))
                       (- y (geom:height o)) t))
    (with-slots (d:gravity d:guide) v
      (ecase d:gravity
        (:top (d:move-tree (d:root v)
                           (geom:x (d:root v))
                           (- (+ d:guide
                                 (geom:y (d:tree-dimensions (d:root v))))
                              (geom:height (d:root v)))
                           t))
        (:bottom (d:move-tree (d:root v)
                              (geom:x (d:root v))
                              (- d:guide
                                 (geom:height (d:root v)))
                              t))
        (:center)
        ((:right :east)
         (d:move-tree (d:root v)
                    (- (gwee:view-width v)
                       (- (geom:x (d:tree-dimensions (d:root v)))
                          (- (geom:x (d:root v))
                             (geom:x (d:tree-coordinates (d:root v)))))
                       2)
                    (geom:y (d:root v))
                    t))
        ((:left :west)
         (d:move-tree (d:root v)
                    (- (geom:x (d:root v))
                       (geom:x (d:tree-coordinates (d:root v)))
                       -2)
                    (geom:y (d:root v))
                    t))))))

(defun display-tree (tree)
  (gwee:with-gui (1024 768 :font "sans.ttf" :background (gwee:gray 255) :foreground (gwee:gray 0))
    (let ((v (make-instance 'linear-view
                            :gravity :center
                            :width 1024 :height 764
                            :parent gwee:*top-view*)))
      (setf (d:root v) tree)
      (d:update-diagram-view v))))
